#lang rosetta-racket


(require "amb.rkt")

(provide segment-walk)


(define (round-c c)
  (xyz
   (round (xyz-x c))
   (round (xyz-y c))
   (round (xyz-z c))))

(define random-interval-round (λ. round random-interval))

;(define (pipe-walk c v0 l n valid-fn)
;  (define (pipe-walk-rec c v0 n)
;    (if (= n 0)
;        (list)
;        (let ((v1 (round-c
;                   (sph
;                    1
;                    (* (random-interval-round 0 4) pi/2)
;                    (* (random-interval-round 0 3) pi/2)))))
;          (cond ((=c v0 (*c v1 -1))
;                 (pipe-walk-rec c v0 n))
;                (else
;                 (let ((top-c (+c c (*c v1 (* (random-interval 0.2 1.0) l)))))
;                   (cond ((list*
;                           (cylinder c (* 0.02 l) top-c)
;                           (sphere top-c (* 0.04 l))
;                           (pipe-walk-rec top-c v1 (- n 1))))
;                         (else
;                          (pipe-walk-rec c v0 n)))))))))
;  
;  (pipe-walk-rec c v0 n))

(define (random-c)
  (amb
   (round-c
    (sph
     1
     (* (random-interval-round 0 4) pi/2)
     (* (random-interval-round 0 3) pi/2)))
   (random-c)))

(define (segment-walk c v0 l n)
  (define (pipe-walk-rec c1 v0 n cs)
    (if (= n 0)
        (reverse cs)
        (let ((v1 (random-c)))
          (cond ((=c v0 (*c v1 -1))
                 (pipe-walk-rec c1 v0 n cs))
                (else
                 (let ((c2 (+c c1 (*c v1 (* (random-interval 0.2 1) l)))))
                   (pipe-walk-rec c2 v1 (- n 1) (cons c2 cs))))))))
  
  (pipe-walk-rec c v0 n (list)))

(define (pipefy cs l)
  (cond ((empty? cs)
         (list))
        ((empty? (rest cs))
         (list (sphere (first cs) (* 0.04 l))))
        (else
         (let ((c (first cs))
               (top-c (second cs)))
           (list*
            (cylinder c (* 0.02 l) top-c)
            (sphere c (* 0.04 l))
            (pipefy (rest cs) l))))))

(define (pipe-walk-cube c w l n)
  (let ((cs (segment-walk c ux l n)))
    (if (every
         (λ (c)
           (and
            (< (abs (xyz-x c)) w)
            (< (abs (xyz-y c)) w)
            (< (abs (xyz-z c)) w)))
         cs)
        (pipefy cs l)
        (fail))))

;(define (pipe-walk-cube-example)
;  (pipe-walk-cube u0 100 80 2000))

(define (pipe-walk-cube-example)
  (pipe-walk-cube u0 100 80 30))